home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d26
/
typdr11.arc
/
SCREENIO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-09-11
|
5KB
|
132 lines
{ SCREENIO is a set of routines to make screen I/O easier.
ReKey restores the function key labels on screen.
OnKey (num, label) activates function key NUM and labels it.
OffKey (num) deactivates function key NUM.
GetKey gets the next keystroke.
GetLine (var inplin) gets a line (can be terminated by function key).
}
uses crt,Turbo3;
type KeyLbl = string [6]; { label for a function key }
Line = string [80];
ScrnArea = array [0..4000] of byte; { a complete screen image }
const KeyLbls : array [1..10] of KeyLbl = ('','','','','','','','','','');
KeyOn : array [1..10] of boolean =
(FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE);
KeyLine : array [0..79] of integer =
{ function key labels formatted for display }
(0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0);
var InChar : char; { where the most recent keyboard input is found }
MonoSeg : array [0..4000] of byte absolute $B000:0;
ColorSeg : array [0..4000] of byte absolute $B800:0;
{ monochrome and color display areas, same layout,
color starts at $B800 }
DispTop : word; { segment start for display }
VidMode : byte absolute $40:$49; { current BIOS video mode }
ScrnStack : array [0..1] of ScrnArea;
procedure ReKey; (* restores function key labels on screen. *)
var i : integer;
begin
if VidMode = 7 then DispTop := $B000 else DispTop := $B800;
for i:= 0 to 79 do
memw [DispTop:3840+2*i] := KeyLine[i];
end;
procedure OnKey (num:integer; lbl:KeyLbl);
(* activates function key NUM and labels it. *)
const Iattr : integer = $7000; { inverse video attribute }
Nattr : integer = $0700; { normal video attribute }
var i,base,len : integer;
begin
KeyOn [num] := TRUE;
KeyLbls [num] := lbl;
{ write NUM in KeyLine, normal video }
base := (num -1) * 8;
if num<>10 then KeyLine [base+1] := num + 48 + Nattr { ASCII for NUM }
else begin { ASCII for '1' '0' }
Keyline [base]:=49+Nattr; KeyLine [base+1]:=48+Nattr;
end;
{ write LBL in KeyLine, inverse video }
base := base + 1; { 2 to the right }
len := length (lbl);
for i:=1 to 6 do KeyLine [base+i] := Iattr;
if len>0 then
for i:=1 to len do Keyline [base+i] := Iattr + integer (lbl [i]);
{ now display it }
ReKey;
end;
procedure OffKey (num:integer);
(* deactivates function key NUM. *)
var i,base : integer;
begin
KeyOn [num] := FALSE;
KeyLbls [num] := '';
base := (num-1) *8;
for i:= base to base+7 do Keyline [i] := 0;
ReKey;
end;
function GetKey : boolean;
(* gets the next keystroke, and puts it in INCHAR.
If normal keystroke, returns TRUE.
If preceded by ESC, returns FALSE.
*)
begin
read (kbd, inchar);
if ((inchar = ^[ { ESC }) and KeyPressed) then
begin { function or cursor key }
read (kbd, inchar);
GetKey := FALSE;
end
else GetKey := TRUE;
end;
function GetLine (var inplin:Line) : boolean;
(* gets a line from the keyboard, appended into INPLINE.
If terminated normally (ENTER), returns TRUE.
If terminated by overflow (>80 chars), returns TRUE.
If terminated by ESC, function or cursor key, returns FALSE,
with the special character in INCHAR.
*)
var done : boolean;
begin
if length (inplin) > 0 then write (inplin);
done := FALSE; GetLine := FALSE;
repeat
if not GetKey then done := TRUE
else
case inchar of
^[: { ESC - treat as special }
done := TRUE;
^M,^J: { newline - normal return }
begin
GetLine := TRUE;
done := TRUE;
end;
^H: { BACKSPACE }
if length (inplin) >0 then
begin
delete (inplin, length (inplin),1); { delete last char }
write (^H' '^H); { wipe last char from screen }
end
else write (^G); { bell to signal error }
else { normal character - append and write }
if length (inplin) >= 80 then
begin
GetLine := TRUE;
done := TRUE;
end
else
begin
inplin := concat (inplin, inchar);
write (inchar);
end;
end;
until done;
end;